home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / HTML / FormatPS.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  16.0 KB  |  674 lines
  1. package HTML::FormatPS;
  2.  
  3.  
  4. $DEFAULT_PAGESIZE = "A4";
  5.  
  6. =head1 NAME
  7.  
  8. HTML::FormatPS - Format HTML as postscript
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.   require HTML::FormatPS;
  13.   $html = parse_htmlfile("test.html");
  14.   $formatter = new HTML::FormatPS
  15.            FontFamily => 'Helvetica',
  16.            PaperSize  => 'Letter';
  17.   print $formatter->format($html);
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. The HTML::FormatPS is a formatter that outputs PostScript code.
  22. Formatting of HTML tables and forms is not implemented.
  23.  
  24. You might specify the following parameters when constructing the formatter:
  25.  
  26. =over 4
  27.  
  28. =item PaperSize
  29.  
  30. What kind of paper should we format for.  The value can be one of
  31. these: A3, A4, A5, B4, B5, Letter, Legal, Executive, Tabloid,
  32. Statement, Folio, 10x14, Quarto.
  33.  
  34. The default is "A4".
  35.  
  36. =item PaperWidth
  37.  
  38. The width of the paper in points.  Setting PaperSize also defines this
  39. value.
  40.  
  41. =item PaperHeight
  42.  
  43. The height of the paper in points.  Setting PaperSize also defines
  44. this value.
  45.  
  46. =item LeftMargin
  47.  
  48. The left margin in points.
  49.  
  50. =item RightMargin
  51.  
  52. The right margin in points.
  53.  
  54. =item HorizontalMargin
  55.  
  56. Both left and right margin at the same time.  The default value is 4 cm.
  57.  
  58. =item TopMargin
  59.  
  60. The top margin in points.
  61.  
  62. =item BottomMargin
  63.  
  64. The bottom margin in points.
  65.  
  66. =item VerticalMargin
  67.  
  68. Both top and bottom margin at the same time.  The default value is 2 cm.
  69.  
  70. =item PageNo
  71.  
  72. The parameter determines if we should put page numbers on the pages.
  73. The default is yes, so you have to set this value to 0 in order to
  74. suppress page numbers.
  75.  
  76. =item FontFamily
  77.  
  78. The parameter specifies which family of fonts to use for the formatting.
  79. Legal values are "Courier", "Helvetica" and "Times".  The default is
  80. "Times".
  81.  
  82. =item FontScale
  83.  
  84. All fontsizes might be scaled by this factor.
  85.  
  86. =item Leading
  87.  
  88. How much space between lines.  This is a factor of the fontsize used
  89. for that line.  Default is 0.1.
  90.  
  91. =back
  92.  
  93. =head1 SEE ALSO
  94.  
  95. L<HTML::Formatter>
  96.  
  97. =head1 COPYRIGHT
  98.  
  99. Copyright (c) 1995 Gisle Aas. All rights reserved.
  100.  
  101. This library is free software; you can redistribute it and/or
  102. modify it under the same terms as Perl itself.
  103.  
  104. =head1 AUTHOR
  105.  
  106. Gisle Aas <aas@oslonett.no>
  107.  
  108. =cut
  109.  
  110. use Carp;
  111.  
  112. require HTML::Formatter;
  113. @ISA = qw(HTML::Formatter);
  114.  
  115. sub mm { $_[0] * 72 / 25.4; }
  116. sub in { $_[0] * 72; }
  117.  
  118. %PaperSizes =
  119. (
  120.  A3        => [mm(297), mm(420)],
  121.  A4        => [mm(210), mm(297)],
  122.  A5        => [mm(148), mm(210)],
  123.  B4        => [729,     1032   ],
  124.  B5        => [516,     729    ],
  125.  Letter    => [in(8.5), in(11) ],
  126.  Legal     => [in(8.5), in(14) ],
  127.  Executive => [in(7.5), in(10) ],
  128.  Tabloid   => [in(11),  in(17) ],
  129.  Statement => [in(5.5), in(8.5)],
  130.  Folio     => [in(8.5), in(13) ],
  131.  "10x14"   => [in(10),  in(14) ],
  132.  Quarto    => [610,     780    ],
  133. );
  134.  
  135. %FontFamilies =
  136. (
  137.  Courier   => [qw(Courier
  138.           Courier-Bold
  139.           Courier-Oblique
  140.           Courier-BoldOblique)],
  141.  
  142.  Helvetica => [qw(Helvetica
  143.           Helvetica-Bold
  144.           Helvetica-Oblique
  145.           Helvetica-BoldOblique)],
  146.  
  147.  Times     => [qw(Times-Roman
  148.           Times-Bold
  149.           Times-Italic
  150.           Times-BoldItalic)],
  151. );
  152.  
  153. @FontSizes = ( 5,  6,  8, 10, 12, 14, 18, 24, 32);
  154.  
  155. sub BOLD   { 0x01; }
  156. sub ITALIC { 0x02; }
  157.  
  158. %param =
  159. (
  160.  papersize        => 'papersize',
  161.  paperwidth       => 'paperwidth',
  162.  paperheight      => 'paperheigth',
  163.  leftmargin       => 'lmW',
  164.  rightmargin      => 'rmW',
  165.  horizontalmargin => 'mW',
  166.  topmargin        => 'tmH',
  167.  bottommargin     => 'bmH',
  168.  verticalmargin   => 'mH',
  169.  pageno           => 'printpageno',
  170.  fontfamily       => 'family',
  171.  fontscale        => 'fontscale',
  172.  leading          => 'leading',
  173. );
  174.  
  175.  
  176. sub new
  177. {
  178.     my $class = shift;
  179.  
  180.     my $self = bless {
  181.     family => "Times",
  182.     mH => mm(40),
  183.     mW => mm(20),
  184.     printpageno => 1,
  185.     fontscale   => 1,
  186.     leading     => 0.1,
  187.     }, $class;
  188.     $self->papersize($DEFAULT_PAGESIZE);
  189.  
  190.     while (($key, $val) = splice(@_, 0, 2)) {
  191.     $key = lc $key;
  192.     croak "Illegal parameter ($key => $val)" unless exists $param{$key};
  193.     $key = $param{$key};
  194.     {
  195.         $key eq "family" && do {
  196.         $val = "\u\L$val";
  197.         croak "Unknown font family ($val)"
  198.           unless exists $FontFamilies{$val};
  199.         $self->{family} = $val;
  200.         last;
  201.         };
  202.         $key eq "papersize" && do {
  203.         $self->papersize($val) || croak "Unknown papersize ($val)";
  204.         last;
  205.         };
  206.         $self->{$key} = lc $val;
  207.     }
  208.     }
  209.     $self->{title} = "";
  210.     $self;
  211. }
  212.  
  213.  
  214. sub papersize
  215. {
  216.     my($self, $val) = @_;
  217.     $val = "\u\L$val";
  218.     my($width, $height) = @{$PaperSizes{$val}};
  219.     return 0 unless defined $width;
  220.     $self->{papersize} = $val;
  221.     $self->{paperwidth} = $width;
  222.     $self->{paperheight} = $height;
  223.     1;
  224. }
  225.  
  226.  
  227. sub fontsize
  228. {
  229.     my $self = shift;
  230.     my $size = $self->{font_size}[-1];
  231.     $size = 8 if $size > 8;
  232.     $size = 3 if $size < 0;
  233.     $FontSizes[$size] * $self->{fontscale};
  234. }
  235.  
  236.  
  237. sub findfont
  238. {
  239.     my($self, $plain_with_size) = @_;
  240.     my $index = 0;
  241.     my $family = $self->{family} || 'Times';
  242.     my $size = $plain_with_size;
  243.     unless ($plain_with_size) {
  244.     $index |= BOLD   if $self->{bold};
  245.     $index |= ITALIC if $self->{italic} || $self->{underline};
  246.     $family = 'Courier' if $self->{teletype};
  247.     $size = $self->fontsize;
  248.     }
  249.     my $font = $FontFamilies{$family}[$index];
  250.     my $font_with_size = "$font-$size";
  251.     if ($self->{currentfont} eq $font_with_size) {
  252.     return "";
  253.     }
  254.     $self->{currentfont} = $font_with_size;
  255.     $self->{pointsize} = $size;
  256.     my $fontmod = "Font::Metrics::$font";
  257.     $fontmod =~ s/-//g;
  258.     my $fontfile = $fontmod . ".pm";
  259.     $fontfile =~ s,::,/,g;
  260.     require $fontfile;
  261.     $self->{wx} = \@{ "${fontmod}::wx" };
  262.     $font = $self->{fonts}{$font_with_size} || do {
  263.     my $fontID = "F" . ++$self->{fno};
  264.     $self->{fonts}{$font_with_size} = $fontID;
  265.     $fontID;
  266.     };
  267.     "$font SF";
  268. }
  269.  
  270.  
  271. sub width
  272. {
  273.     my $self = shift;
  274.     my $w = 0;
  275.     my $wx = $self->{wx};
  276.     my $sz = $self->{pointsize};
  277.     while ($_[0] =~ /(.)/g) {
  278.     $w += $wx->[ord $1] * $sz;
  279.     }
  280.     $w;
  281. }
  282.  
  283.  
  284. sub begin
  285. {
  286.     my $self = shift;
  287.     $self->HTML::Formatter::begin;
  288.  
  289.     $self->{lm} = $self->{lmW} || $self->{mW};
  290.     $self->{rm} = $self->{paperwidth}  - ($self->{rmW} || $self->{mW});
  291.     $self->{tm} = $self->{paperheight} - ($self->{tmH} || $self->{mH});
  292.     $self->{bm} = $self->{bmH} || $self->{mH};
  293.  
  294.     $self->{fno} = 0;
  295.     $self->{fonts} = {};
  296.     $self->{en} = 0.55 * $self->fontsize(3);
  297.  
  298.     $self->{xpos} = $self->{lm};  # top of the current line
  299.     $self->{ypos} = $self->{tm};
  300.  
  301.     $self->{pageno} = 1;
  302.  
  303.     $self->{line} = "";
  304.     $self->{showstring} = "";
  305.     $self->{currentfont} = "";
  306.     $self->{prev_currentfont} = "";
  307.     $self->{largest_pointsize} = 0;
  308.  
  309.     $self->newpage;
  310. }
  311.  
  312.  
  313. sub end
  314. {
  315.     my $self = shift;
  316.     $self->showline;
  317.     $self->endpage if $self->{out};
  318.     my $pages = $self->{pageno} - 1;
  319.  
  320.     my @prolog = ();
  321.     push(@prolog, "%!PS-Adobe-3.0\n");
  322.     push(@prolog, "%%Creator: HTML::FormatPS (libwww-perl)\n");
  323.     push(@prolog, "%%CreationDate: " . localtime() . "\n");
  324.     push(@prolog, "%%Pages: $pages\n");
  325.     push(@prolog, "%%PageOrder: Ascend\n");
  326.     push(@prolog, "%%Orientation: Portrait\n");
  327.     my($pw, $ph) = map { int($_); } @{$self}{qw(paperwidth paperheight)};
  328.  
  329.     push(@prolog, "%%DocumentMedia: Plain $pw $ph 0 white ()\n");
  330.     push(@prolog, "%%DocumentNeededResources: \n");
  331.     my($full, %seenfont);
  332.     for $full (sort keys %{$self->{fonts}}) {
  333.     $full =~ s/-\d+$//;
  334.     next if $seenfont{$full}++;
  335.     push(@prolog, "%%+ font $full\n");
  336.     }
  337.     push(@prolog, "%%DocumentSuppliedResources: procset newencode 1.0 0\n");
  338.     push(@prolog, "%%+ encoding ISOLatin1Encoding\n");
  339.     push(@prolog, "%%EndComments\n");
  340.     push(@prolog, <<'EOT');
  341.  
  342. %%BeginProlog
  343. /S/show load def
  344. /M/moveto load def
  345. /SF/setfont load def
  346.  
  347. %%BeginResource: encoding ISOLatin1Encoding
  348. systemdict /ISOLatin1Encoding known not {
  349.     /ISOLatin1Encoding [
  350.     /space /space /space /space /space /space /space /space
  351.     /space /space /space /space /space /space /space /space
  352.     /space /space /space /space /space /space /space /space
  353.     /space /space /space /space /space /space /space /space
  354.     /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
  355.         /quoteright
  356.     /parenleft /parenright /asterisk /plus /comma /minus /period /slash
  357.     /zero /one /two /three /four /five /six /seven
  358.     /eight /nine /colon /semicolon /less /equal /greater /question
  359.     /at /A /B /C /D /E /F /G
  360.     /H /I /J /K /L /M /N /O
  361.     /P /Q /R /S /T /U /V /W
  362.     /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
  363.     /quoteleft /a /b /c /d /e /f /g
  364.     /h /i /j /k /l /m /n /o
  365.     /p /q /r /s /t /u /v /w
  366.     /x /y /z /braceleft /bar /braceright /asciitilde /space
  367.     /space /space /space /space /space /space /space /space
  368.     /space /space /space /space /space /space /space /space
  369.     /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
  370.     /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
  371.     /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
  372.     /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
  373.         /registered /macron
  374.     /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
  375.         /periodcentered
  376.     /cedillar /onesuperior /ordmasculine /guillemotright /onequarter
  377.         /onehalf /threequarters /questiondown
  378.     /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
  379.     /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
  380.         /Idieresis
  381.     /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
  382.     /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
  383.         /germandbls
  384.     /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
  385.     /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
  386.         /idieresis
  387.     /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
  388.     /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
  389.         /ydieresis
  390.     ] def
  391. } if
  392. %%EndResource
  393. %%BeginResource: procset newencode 1.0 0
  394. /NE { %def
  395.    findfont begin
  396.       currentdict dup length dict begin
  397.      { %forall
  398.         1 index/FID ne {def} {pop pop} ifelse
  399.      } forall
  400.      /FontName exch def
  401.      /Encoding exch def
  402.      currentdict dup
  403.       end
  404.    end
  405.    /FontName get exch definefont pop
  406. } bind def
  407. %%EndResource
  408. %%EndProlog
  409. EOT
  410.  
  411.     push(@prolog, "\n%%BeginSetup\n");
  412.     for $full (sort keys %{$self->{fonts}}) {
  413.     my $short = $self->{fonts}{$full};
  414.     $full =~ s/-(\d+)$//;
  415.     my $size = $1;
  416.     push(@prolog, "ISOLatin1Encoding/$full-ISO/$full NE\n");
  417.     push(@prolog, "/$short/$full-ISO findfont $size scalefont def\n");
  418.     }
  419.     push(@prolog, "%%EndSetup\n");
  420.  
  421.     $self->collect("\n%%Trailer\n%%EOF\n");
  422.     unshift(@{$self->{output}}, @prolog);
  423. }
  424.  
  425.  
  426. sub header_start
  427. {
  428.     my($self, $level, $node) = @_;
  429.     $self->vspace(1 + (6-$level) * 0.4);
  430.     $self->eat_leading_space;
  431.     $self->{bold}++;
  432.     push(@{$self->{font_size}}, 8 - $level);
  433.     1;
  434. }
  435.  
  436.  
  437. sub header_end
  438. {
  439.     my($self, $level, $node) = @_;
  440.     $self->vspace(1);
  441.     $self->{bold}--;
  442.     pop(@{$self->{font_size}});
  443.     1;
  444. }
  445.  
  446. sub hr_start
  447. {
  448.     my $self = shift;
  449.     $self->showline;
  450.     $self->vspace(0.5);
  451.     $self->skip_vspace;
  452.     my $lm = $self->{lm};
  453.     my $rm = $self->{rm};
  454.     my $y = $self->{ypos};
  455.     $self->collect(sprintf "newpath %.1f %.1f M %.1f %.1f lineto stroke\n",
  456.            $lm, $y, $rm, $y);
  457.     $self->vspace(0.5);
  458. }
  459.  
  460.  
  461. sub skip_vspace
  462. {
  463.     my $self = shift;
  464.     if (defined $self->{vspace}) {
  465.     $self->showline;
  466.     if ($self->{out}) {
  467.         $self->{ypos} -= $self->{vspace} * 10 * $self->{fontscale};
  468.         if ($self->{ypos} < $self->{bm}) {
  469.         $self->newpage;
  470.         }
  471.     }
  472.     $self->{xpos} = $self->{lm};
  473.     $self->{vspace} = undef;
  474.     }
  475. }
  476.  
  477.  
  478. sub show
  479. {
  480.     my $self = shift;
  481.     my $str = $self->{showstring};
  482.     return unless length $str;
  483.     $str =~ s/([\(\)\\])/\\$1/g;    # must escape parentesis
  484.     $self->{line} .= "($str)S\n";
  485.     $self->{showstring} = "";
  486. }
  487.  
  488.  
  489. sub showline
  490. {
  491.     my $self = shift;
  492.     $self->show;
  493.     my $line = $self->{line};
  494.     return unless length $line;
  495.     $self->{ypos} -= $self->{largest_pointsize} || $self->{pointsize};
  496.     if ($self->{ypos} < $self->{bm}) {
  497.     $self->newpage;
  498.     $self->{ypos} -= $self->{pointsize};
  499.     my $font = $self->{prev_currentfont};
  500.     if ($font) {
  501.         $self->collect("$self->{fonts}{$font} SF\n");
  502.     }
  503.     }
  504.     my $lm = $self->{lm};
  505.     my $x = $lm;
  506.     if ($self->{center}) {
  507.     my $linewidth = $self->{xpos} - $lm;
  508.     $x += ($self->{rm} - $lm - $linewidth) / 2;
  509.     }
  510.  
  511.     $self->collect(sprintf "%.1f %.1f M\n", $x, $self->{ypos});  # moveto
  512.     $line =~ s/\s\)S$/)S/;  # many lines will end with space
  513.     $self->collect($line);
  514.  
  515.     if ($self->{bullet}) {
  516.     my $bullet = $self->{bullet};
  517.     if ($bullet eq '*') {
  518.         my $radius = $self->{pointsize} / 4;
  519.         $self->collect(sprintf "newpath %.1f %.1f %.1f 0 360 arc fill\n",
  520.                $self->{bullet_pos} + $radius,
  521.                $self->{ypos} + $radius, $radius);
  522.     } else {
  523.         $self->collect(sprintf "%.1f %.1f M\n", # moveto
  524.                $self->{bullet_pos},
  525.                $self->{ypos});
  526.         $self->collect("($bullet)S\n");
  527.     }
  528.     $self->{bullet} = '';
  529.  
  530.     }
  531.  
  532.     $self->{prev_currentfont} = $self->{currentfont};
  533.     $self->{largest_pointsize} = 0;
  534.     $self->{line} = "";
  535.     $self->{xpos} = $lm;
  536.     $self->{ypos} -= $self->{leading} * $self->{pointsize};
  537. }
  538.  
  539.  
  540. sub endpage
  541. {
  542.     my $self = shift;
  543.     $self->collect("showpage\n");
  544.     $self->{pageno}++;
  545. }
  546.  
  547.  
  548. sub newpage
  549. {
  550.     my $self = shift;
  551.     if ($self->{'out'}) {
  552.     $self->endpage;
  553.     }
  554.     $self->{'out'} = 0;
  555.     my $pageno = $self->{pageno};
  556.     $self->collect("\n%%Page: $pageno $pageno\n");
  557.  
  558.     if ($DEBUG) {
  559.     my($llx, $lly, $urx, $ury) = map { sprintf "%.1f", $_}
  560.                      @{$self}{qw(lm bm rm tm)};
  561.     $self->collect("gsave 0.1 setlinewidth\n");
  562.     $self->collect("clippath 0.9 setgray fill 1 setgray\n");
  563.     $self->collect("$llx $lly moveto $urx $lly lineto $urx $ury lineto $llx $ury lineto closepath fill\n");
  564.     $self->collect("grestore\n");
  565.     }
  566.  
  567.     if ($self->{printpageno}) {
  568.     $self->collect("%% Title and pageno\n");
  569.     my $f = $self->findfont(8);
  570.     $self->collect("$f\n") if $f;
  571.         my $x = $self->{paperwidth};
  572.         if ($x) { $x -= 30; } else { $x = 30; }
  573.         $self->collect(sprintf "%.1f 30.0 M($pageno)S\n", $x);
  574.     $x = $self->{lm};
  575.     $self->collect(sprintf "%.1f 30.0 M($self->{title})S\n", $x);
  576.     }
  577.     $self->collect("\n");
  578.  
  579.     $self->{xpos} = $self->{lm};
  580.     $self->{ypos} = $self->{tm};
  581. }
  582.  
  583.  
  584. sub out
  585. {
  586.     my($self, $text) = @_;
  587.     if ($self->{collectingTheTitle}) {
  588.         $text =~ s/([\(\)\\])/\\$1/g; # Escape parens.
  589.         $self->{title} .= $text;
  590.     return;
  591.     }
  592.     $self->skip_vspace;
  593.  
  594.     my $font = $self->findfont();
  595.     if (length $font) {
  596.     $self->show;
  597.     $self->{line} .= "$font\n";
  598.     }
  599.     my $w = $self->width($text);
  600.     if ($self->{xpos} + $w > $self->{rm}) {
  601.     $self->showline;
  602.     return if $text =~ /^\s*$/;
  603.     };
  604.     $self->{xpos} += $w;
  605.     $self->{showstring} .= $text;
  606.     $self->{largest_pointsize} = $self->{pointsize}
  607.       if $self->{largest_pointsize} < $self->{pointsize};
  608.     $self->{'out'}++;
  609. }
  610.  
  611.  
  612. sub pre_out
  613. {
  614.     my($self, $text) = @_;
  615.     $self->skip_vspace;
  616.     $self->tt_start;
  617.     my $font = $self->findfont();
  618.     if (length $font) {
  619.     $self->show;
  620.     $self->{line} .= "$font\n";
  621.     }
  622.     while ($text =~ s/(.*)\n//) {
  623.         $self->{'out'}++;
  624.     $self->{showstring} .= $1;
  625.     $self->showline;
  626.     }
  627.     $self->{showstring} .= $text;
  628.     $self->tt_end;
  629. }
  630.  
  631. sub bullet
  632. {
  633.     my($self, $bullet) = @_;
  634.     $self->{bullet} = $bullet;
  635.     $self->{bullet_pos} = $self->{lm};
  636. }
  637.  
  638. sub adjust_lm
  639. {
  640.     my $self = shift;
  641.     $self->showline;
  642.     $self->{lm} += $_[0] * $self->{en};
  643. }
  644.  
  645.  
  646. sub adjust_rm
  647. {
  648.     my $self = shift;
  649.     $self->showline;
  650.     $self->{rm} += $_[0] * $self->{en};
  651. }
  652.  
  653. sub head_start {
  654.     1;
  655. }
  656.  
  657. sub head_end {
  658.     1;
  659. }
  660.  
  661. sub title_start {
  662.     my($self) = @_;
  663.     $self->{collectingTheTitle} = 1;
  664.     1;
  665. }
  666.  
  667. sub title_end {
  668.     my($self) = @_;
  669.     $self->{collectingTheTitle} = 0;
  670.     1;
  671. }
  672.  
  673. 1;
  674.